home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Environments / Clean 1.2.4 / IOInterface / windowInternal.icl < prev    next >
Encoding:
Modula Implementation  |  1997-06-16  |  15.5 KB  |  371 lines  |  [TEXT/3PRM]
  1. implementation module windowInternal;
  2.  
  3. import StdClass,StdInt,StdBool,StdString,StdList,StdFunc;
  4. import    pointer, structure, windows, quickdraw, controls;
  5. import    commonDef, ioState, windowInternal2, windowAccess;
  6. from    Picture import MakePicture, MakeMacPicture, Vector;
  7.  
  8. ::    DeltaControl :== Toolbox -> Toolbox;
  9.  
  10. //    Scrolling windows.
  11.  
  12. ScrollingAreaIsVisible :: !WindowPtr !Vector !(!Int,!Int) !Toolbox -> (![Rect],!Toolbox);
  13. ScrollingAreaIsVisible wPtr (dx,dy) (width,height) tb
  14. |    frameVisible            = ([],            QDisposeRgn invisRgn tb5);        // The whole frame is visible
  15. |    emptyWrong                = ([],            QDisposeRgn wrongRgn tb9);        // The scrolled part remains invisible
  16.                             = ([wrongRect],    QDisposeRgn wrongRgn tb10);        // The bounding rect of the new visible part
  17.     where {
  18.         frameWidth            = width -ScrollBarWidth;
  19.         frameHeight            = height-ScrollBarWidth;
  20.         scrollframe            = (0,0, frameWidth,frameHeight);
  21.         (visRgn,tb1)        = LoadLong (wPtr+24) tb;                        // Load the visRgnHandle
  22.         (frameRgn,tb2)        = QNewRgn tb1;
  23.         tb3                    = QRectRgn frameRgn scrollframe tb2;            // Set the whole window frame
  24.         (invisRgn,tb4)        = QDiffRgn frameRgn visRgn frameRgn tb3;        // whole window - visRgn = invisRgn
  25.         (frameVisible,tb5)    = QEmptyRgn invisRgn tb4;
  26.         tb6                    = QOffsetRgn invisRgn dx dy tb5;                // Scroll the invisRgn
  27.         (newRgn,tb7)        = QNewRgn tb6;
  28.         (wrongRgn,tb8)        = QSectRgn invisRgn visRgn invisRgn tb7;        // Intersect scrolled invisRgn with visRgn
  29.         (emptyWrong,tb9)    = QEmptyRgn wrongRgn tb8;
  30.         (wrongRect,tb10)    = loadRgnBBox wrongRgn tb9;
  31.         
  32.         loadRgnBBox :: !RgnHandle !Toolbox -> (!Rect,!Toolbox);
  33.         loadRgnBBox rgnH tb
  34.         =    ((left,top, right,bottom),tb5);
  35.             where {
  36.                 (rgnPtr,tb1)    = LoadLong rgnH tb;
  37.                 rectPtr            = 2+rgnPtr;                                    // rgnBBox offset
  38.                 (top,   tb2)    = LoadWord rectPtr        tb1;
  39.                 (left,  tb3)    = LoadWord (rectPtr+2)    tb2;
  40.                 (bottom,tb4)    = LoadWord (rectPtr+4)    tb3;
  41.                 (right, tb5)    = LoadWord (rectPtr+6)    tb4;
  42.             };
  43.     };
  44.  
  45. MoveRect :: !Vector !Rect -> Rect;
  46. MoveRect (dx,dy) (left,top, right,bottom) = (left+dx,top+dy, right+dx,bottom+dy);
  47.  
  48. RectToRectangle :: !Rect -> Rectangle;
  49. RectToRectangle (left,top, right,bottom) = ((left,top),(right,bottom));
  50.  
  51. NewUpdateArea wPtr hBar vBar pict updArea new zoom
  52.     :==    (wPtr, hBar, vBar, pict, AppendUpdateAreas new updArea, zoom);
  53.  
  54. Scroll_window :: !Window !Int !Int !Int !Int !(UpdateFunction *s) !*s !Toolbox
  55.     ->    (!Window, !*s, !Toolbox);
  56. Scroll_window window oldHpos oldVpos hPos vPos f s tb
  57. |    oldHpos == hPos    = Scroll_window_vertical    window oldHpos oldVpos vPos         f s tb;
  58. |    oldVpos == vPos    = Scroll_window_horizontal    window oldVpos oldHpos hPos         f s tb;
  59.                     = Scroll_window_diagonal    window oldHpos oldVpos hPos vPos f s tb;
  60.  
  61. Scroll_window_vertical :: !Window !Int !Int !Int !(UpdateFunction *s) !*s !Toolbox
  62.     ->    (!Window, !*s, !Toolbox);
  63. Scroll_window_vertical window=:(wPtr, hBar, vBar, pict, upd, zoom) hPos oldVpos vPos f s tb
  64. |    dv1 > 0 && dv1 < h2    = Draw_window down [(0,h2 - dv1,w2,h2):wrongRects]    DrawNoControls f s scroll;
  65. |    dv2 > 0 && dv2 < h2    = Draw_window up   [(0,0,w2,dv2):wrongRects]        DrawNoControls f s scroll;
  66. |    dv1 <> 0            = Draw_window page [rect]                            DrawNoControls f s tb2;
  67.                         = (window, s, tb2);
  68.     where {
  69.         rect            = (0, 0, w2, h2);
  70.         dv1                = vPos - oldVpos;            dv2        = oldVpos - vPos;
  71.         w2                = w - ScrollBarWidth;        h2        = h - ScrollBarWidth;
  72.         hPos`            = hPos + w2;                vPos`    = vPos + h2;
  73.         (w,h)            = size;
  74.         (size,tb1)        = Window_size wPtr tb;
  75.         (wrongRects,tb2)= ScrollingAreaIsVisible wPtr (0,dv2) (w,h) tb1;
  76.         wrongAreas        = map (RectToRectangle o MoveRect (hPos,vPos)) wrongRects;
  77.         scroll            = DoScroll wPtr w2 h2 0 dv2 tb2;
  78.         down            = NewUpdateArea wPtr hBar vBar pict upd [((hPos,vPos` - dv1),(hPos`,vPos`)):wrongAreas] zoom;
  79.         up                = NewUpdateArea wPtr hBar vBar pict upd [((hPos,vPos), (hPos`,vPos + dv2)) :wrongAreas] zoom;
  80.         page            = (wPtr, hBar, vBar, pict, [((hPos, vPos), (hPos`, vPos`))], zoom);
  81.     };
  82.  
  83. Scroll_window_horizontal :: !Window !Int !Int !Int !(UpdateFunction *s) !*s !Toolbox
  84.     ->    (!Window, !*s, !Toolbox);
  85. Scroll_window_horizontal window=:(wPtr, hBar, vBar, pict, upd, zoom) vPos oldHpos hPos f s tb
  86. |    dh1 > 0 && dh1 < w2    = Draw_window right [(w2-dh1,0, w2,h2):wrongRects]    DrawNoControls f s scroll;
  87. |    dh2 > 0 && dh2 < w2    = Draw_window left  [(0,0, dh2,h2):wrongRects]        DrawNoControls f s scroll;
  88. |    dh1 <> 0            = Draw_window page  [rect]                            DrawNoControls f s tb2;
  89.                         = (window, s, tb2);
  90.     where {
  91.         rect            = (0, 0, w2, h2);
  92.         dh1                = hPos - oldHpos;            dh2        = oldHpos - hPos;
  93.         w2                = w - ScrollBarWidth;        h2        = h - ScrollBarWidth;
  94.         hPos`            = hPos + w2;                vPos`    = vPos + h2;
  95.         (w,h)            = size;
  96.         (size, tb1)        = Window_size wPtr tb;
  97.         (wrongRects,tb2)= ScrollingAreaIsVisible wPtr (dh2,0) (w,h) tb1;
  98.         wrongAreas        = map (RectToRectangle o MoveRect (hPos,vPos)) wrongRects;
  99.         scroll            = DoScroll wPtr w2 h2 dh2 0 tb2;
  100.         right            = NewUpdateArea wPtr hBar vBar pict upd [((hPos` - dh1,vPos),(hPos`,vPos`)):wrongAreas] zoom;
  101.         left            = NewUpdateArea wPtr hBar vBar pict upd [((hPos,vPos), (hPos + dh2,vPos`)) :wrongAreas] zoom;
  102.         page            = (wPtr, hBar, vBar, pict, [((hPos, vPos), (hPos`, vPos`))], zoom);
  103.     };
  104.  
  105. Scroll_window_diagonal :: !Window !Int !Int !Int !Int !(UpdateFunction *s) !*s !Toolbox
  106.     ->    (!Window, !*s, !Toolbox);
  107. Scroll_window_diagonal window=:(wPtr, hBar, vBar, pict, upd, zoom) oldHpos oldVpos hPos vPos f s tb
  108. |    pos_dh2 && pos_dv2 && l_dh2 && l_dv2    = DiagScroll l_u r_l_u wrongRects w2 h2 dh2 dv2 window1 f s tb2;
  109. |    pos_dh1 && pos_dv2 && l_dh1 && l_dv2    = DiagScroll r_u r_r_u wrongRects w2 h2 dh2 dv2 window1 f s tb2;
  110. |    pos_dh1 && pos_dv1 && l_dh1 && l_dv1    = DiagScroll r_d r_r_d wrongRects w2 h2 dh2 dv2 window1 f s tb2;
  111. |    pos_dh2 && pos_dv1 && l_dh2 && l_dv1    = DiagScroll l_d r_l_d wrongRects w2 h2 dh2 dv2 window1 f s tb2;
  112.                                             = Draw_window page [(0,0, w2,h2)] DrawNoControls f s tb2;
  113.     where {
  114.         dh1             = hPos - oldHpos;            pos_dh1    = dh1 > 0;        l_dh1 = dh1 < w2;
  115.         dh2             = oldHpos - hPos;            pos_dh2    = dh2 > 0;        l_dh2 = dh2 < w2;
  116.         dv1                = vPos - oldVpos;            pos_dv1    = dv1 > 0;        l_dv1 = dv1 < h2;
  117.         dv2                = oldVpos - vPos;            pos_dv2    = dv2 > 0;        l_dv2 = dv2 < h2;
  118.         w2                = w - ScrollBarWidth;        h2        = h - ScrollBarWidth;
  119.         hPos`            = hPos + w2;                vPos`    = vPos + h2;
  120.         (w,h)            = size;
  121.         (size,tb1)        = Window_size wPtr tb;
  122.         (wrongRects,tb2)= ScrollingAreaIsVisible wPtr (dh2,dv2) (w,h) tb1;
  123.         wrongAreas        = map (RectToRectangle o MoveRect (hPos,vPos)) wrongRects;
  124.         window1            = NewUpdateArea wPtr hBar vBar pict upd wrongAreas zoom;
  125.         left_top        = (hPos,  vPos);
  126.         right_bot        = (hPos`, vPos`);
  127.         l_u                = ((left_top, (hPos + dh2, vPos`)),((hPos + dh2, vPos), (hPos`, vPos + dv2)));
  128.         r_l_u            = ((0, 0, dh2, h2), (dh2, 0, w2, dv2));
  129.         r_u                = (((hPos` - dh1, vPos), right_bot), (left_top, (hPos` - dh1, vPos + dv2)));
  130.         r_r_u            = ((w2 - dh1, 0, w2, h2), (0, 0, w2 - dh1, dv2));
  131.         r_d                = (((hPos` - dh1, vPos), right_bot), ((hPos, vPos` - dv1), (hPos` - dh1, vPos`)));
  132.         r_r_d            = ((w2 - dh1, 0, w2, h2), (0, h2 - dv1, w2 - dh1, h2));
  133.         l_d                = ((left_top, (hPos + dh2, vPos`)), ((hPos + dh2, vPos` - dv1), right_bot));
  134.         r_l_d            = ((0, 0, dh2, h2), (dh2, h2 - dv1, w2, h2));
  135.         page            = (wPtr, hBar, vBar, pict, [((hPos, vPos), (hPos`, vPos`))], zoom);
  136.     };
  137.  
  138. DiagScroll :: !(!Rectangle, !Rectangle) !(!Rect, !Rect) ![Rect] !Int !Int !Int !Int !Window
  139.         !(UpdateFunction *s) !*s !Toolbox
  140.     ->    (!Window, !*s, !Toolbox);
  141. DiagScroll (upd1, upd2) (rect1, rect2) wrongRects w h dh dv window=:(wPtr, hBar, vBar, pict, updArea, zoom) f s tb
  142.     =     Draw_window window3 [rect2:wrongRects] DrawNoControls f s2 tb2;
  143.     where {
  144.         window3                = (wPtr2, hBar2, vBar2, pict2, AppendUpdateAreas [upd2] updArea2, zoom2);
  145.         (wPtr2, hBar2, vBar2, pict2, updArea2, zoom2)= window2;
  146.         (window2, s2, tb2)    = Draw_window window1 [rect1:wrongRects] DrawNoControls f s scroll;
  147.         window1                = (wPtr, hBar, vBar, pict, AppendUpdateAreas [upd1] updArea, zoom);
  148.         scroll                = DoScroll wPtr w h dh dv tb;
  149.     };
  150.  
  151. DoScroll :: !WindowPtr !Int !Int !Int !Int !Toolbox -> Toolbox;
  152. DoScroll wPtr w h dh dv tb
  153.     =    tb3;
  154.     where {
  155.         (newRgn,tb1)= QNewRgn tb;
  156.         tb2            = InGrafport2 wPtr (QScrollRect (0,0, w,h) dh dv newRgn) tb1;
  157.         tb3            = QDisposeRgn newRgn tb2;
  158.     };
  159.  
  160. //    Dragging windows.
  161.  
  162. Drag_window    :: !WindowPtr !Int !Int !Toolbox -> Toolbox;
  163. Drag_window wPtr h v tb
  164.     =    DragWindow wPtr h v  (sL, sT, dec sR, dec sB) tb1;
  165.     where {
  166.         (sL, sT, sR, sB, tb1)= QScreenRect tb;
  167.     };
  168.  
  169.  
  170. //    (Re)Drawing windows.
  171.  
  172. DrawScrollBarsAndGrowIcon :: !WindowPtr !Int !Int !DrawMode !Toolbox -> Toolbox;
  173. DrawScrollBarsAndGrowIcon wPtr w h HasControls tb
  174.     =    tb5;
  175.     where {
  176.         tb1            = QEraseRect (w-15,0,    w,h-15)    tb;
  177.         tb2            = QEraseRect (0,   h-15, w,h   )    tb1;
  178.         (rgn, tb3)    = LoadLong     (wPtr+24)                tb2;
  179.         tb4            = UpdtControl wPtr rgn                tb3;
  180.         tb5            = DrawGrowIcon wPtr                    tb4;
  181.     };
  182. DrawScrollBarsAndGrowIcon _ _ _ _ tb = tb;
  183.  
  184. ChangePicture :: ![DrawFunction] !Toolbox -> Toolbox;
  185. ChangePicture fs mp = MakeMacPicture (ChangePicture` fs (MakePicture mp));
  186.  
  187. ChangePicture`    :: ![DrawFunction] !Picture -> Picture;
  188. ChangePicture` [f : fs] picture = ChangePicture` fs (f picture);
  189. ChangePicture` fs       picture = picture;
  190.  
  191. F :: *s (UpdateFunction *s) UpdateArea !Toolbox -> (!Toolbox, !*s);
  192. F s f updArea tb
  193.     =     (MakeMacPicture (ChangePicture` fs (MakePicture tb)), s1);
  194.         where {
  195.         (s1, fs)= f updArea s;
  196.         };
  197.  
  198. Draw_in_window :: !Window !DrawMode ![DrawFunction] !Toolbox -> (!Window, !Toolbox);
  199. Draw_in_window    window=:(wPtr,hBar=:(hControl,hScroll,hMax),vBar=:(vControl,vScroll,vMax),pict,updArea,zoom)
  200.                 mode fs tb
  201.     =    (window, tb11);
  202.     where {
  203.         (port,    tb1)    = QGetPort tb;
  204.         tb2                = QSetPort wPtr tb1;
  205.         (newRgn,tb3)    = QNewRgn tb2;
  206.         (rgn,    tb4)    = QGetClip newRgn tb3;
  207.         (size,    tb5)    = Window_size wPtr tb4;
  208.         (w, h)            = size;
  209.         (vThumb,tb6)    = GetCtlValue vControl tb5;
  210.         (hThumb,tb7)    = GetCtlValue hControl tb6;
  211.         tb8                = QClipRect (DrawModeClipRect hThumb vThumb w h mode) tb7;
  212.         tb9                = QSetOrigin hThumb vThumb tb8;
  213.         tb10            = ChangePicture fs tb9;
  214.         tb11            = QDisposeRgn rgn (QSetPort port (QSetClip rgn (QSetOrigin 0 0 tb10)));
  215.         };
  216.  
  217. DrawModeClipRect :: !Int !Int !Int !Int !DrawMode -> Rect;
  218. DrawModeClipRect x y w h HasNoControls    = (x,y, x+w,y+h);
  219. DrawModeClipRect x y w h hasControls    = (x,y, x+w-ScrollBarWidth,y+h-ScrollBarWidth);
  220.  
  221. Draw_window :: !Window ![Rect] !DrawMode !(UpdateFunction *s) !*s !Toolbox -> (!Window, !*s, !Toolbox);
  222. Draw_window (wPtr,hBar=:(hControl,hScroll,hMax),vBar=:(vControl,vScroll,vMax),pict,updArea,zoom) rects mode f s tb
  223.     =    ((wPtr, hBar, vBar, pict, [], zoom), s1, tb13);
  224.     where {
  225.         (port, tb1)        = QGetPort tb;
  226.         tb2                = QSetPort wPtr tb1;
  227.         (newRgn,tb3)    = QNewRgn tb2;
  228.         (rgn, tb4)        = QGetClip newRgn tb3;
  229.         (size, tb5)        = Window_size wPtr tb4;
  230.         (w, h)            = size;
  231.         tb6                = DrawScrollBarsAndGrowIcon wPtr w h mode tb5;
  232.         (hThumb, tb7)    = GetCtlValue hControl tb6;
  233.         (vThumb, tb8)    = GetCtlValue vControl tb7;
  234.         (clipRgn,tb9)    = CreateClipRgn (map (MoveRect (hThumb,vThumb)) rects) tb8;
  235.         tb10            = QSetClip clipRgn tb9;
  236.         tb11            = QSetOrigin hThumb vThumb tb10;
  237.         (tb12, s1)        = F s f updArea tb11;
  238.         tb13            = QDisposeRgn rgn (QDisposeRgn clipRgn (QSetPort port (QSetClip rgn (QSetOrigin 0 0 tb12))));
  239.         
  240.         CreateClipRgn :: ![Rect] !Toolbox -> (!RgnHandle,!Toolbox);
  241.         CreateClipRgn rects tb
  242.         =    (clipRgn,tb4);
  243.             where {
  244.                 (clipRgn,tb1)    = QNewRgn tb;
  245.                 (aidRgn,tb2)    = QNewRgn tb1;
  246.                 tb3                = CreateClipRgn` rects clipRgn aidRgn tb2;
  247.                 tb4                = QDisposeRgn aidRgn tb3;
  248.             };
  249.         
  250.         CreateClipRgn` :: ![Rect] !RgnHandle !RgnHandle !Toolbox -> Toolbox;
  251.         CreateClipRgn` [rect:rects] clipRgn aidRgn tb
  252.         =    CreateClipRgn` rects clipRgn1 aidRgn tb2;
  253.             where {
  254.                 tb1                = QRectRgn aidRgn rect tb;
  255.                 (clipRgn1,tb2)    = QUnionRgn clipRgn aidRgn clipRgn tb1;
  256.             };
  257.         CreateClipRgn` _ _ _ tb
  258.         =    tb;
  259.     };
  260.  
  261.  
  262. //    Rules for ControlHandling.
  263.  
  264. DoHilitControl :: !ControlHandle !Window !Int !DeltaControl !(UpdateFunction *s) !*s !Toolbox
  265.     ->    (!Window, !*s, !Toolbox);
  266. DoHilitControl control window part f update s tb
  267.     =     (window1, s1, HiliteControl control 0 tb2);
  268.     where {
  269.         (window1, s1, tb2)    = DoControl control window part f update s tb1;
  270.         tb1                    = HiliteControl control part tb;
  271.     };
  272.  
  273. DoControl :: !ControlHandle !Window !Int !DeltaControl !(UpdateFunction *s) !*s !Toolbox
  274.     ->    (!Window, !*s, !Toolbox);
  275. DoControl control window=:(wPtr, hBar, vBar, pict, updArea, zoom) part f update s tb
  276.     =    DoControl2 control window part hPos vPos f update s tb2;
  277.     where {
  278.         (hControl, hScroll, hMax)    = hBar;
  279.         (vControl, vScroll, vMax)    = vBar;
  280.         (hPos, tb1)                    = GetCtlValue hControl tb;
  281.         (vPos, tb2)                    = GetCtlValue vControl tb1;
  282.     };
  283.  
  284. DoControl2 :: !ControlHandle !Window !Int !Int !Int !DeltaControl !(UpdateFunction *s) !*s !Toolbox
  285.     ->    (!Window, !*s, !Toolbox);
  286. DoControl2 control window part oldHpos oldVpos f update s tb
  287.     =     DoControl3 control window part oldHpos oldVpos f update s (f tb);
  288.  
  289. DoControl3    :: !ControlHandle !Window !Int !Int !Int !DeltaControl !(UpdateFunction *s) !*s !Toolbox
  290.     ->    (!Window, !*s, !Toolbox);
  291. DoControl3 control window=:(wPtr, hBar, vBar, pict, updArea, zoom) part oldHpos oldVpos f update s tb
  292. |    not mouseDown        = (doScroll, s1, tb4);
  293. |    part1 == part
  294. &&    control1 == control    = DoControl2 control doScroll part hPos vPos f update s1 tb6;
  295.                         = waitForMouseInControlPart control doScroll part f update s1 tb6;
  296.     where {
  297.         (hControl, hScroll, hMax)    = hBar;
  298.         (vControl, vScroll, vMax)    = vBar;
  299.         (hPos, tb1)                    = GetCtlValue hControl tb;
  300.         (vPos, tb2)                    = GetCtlValue vControl tb1;
  301.         (doScroll, s1, tb3)            = Scroll_window window oldHpos oldVpos hPos vPos update s tb2;
  302.         (mouseDown, tb4)            = WaitMouseUp tb3;
  303.         (mouse, tb5)                = InGrafport wPtr GetMousePosition tb4;
  304.         (h1, v1)                     = mouse;
  305.         (part1, control1, tb6)        = FindControl h1 v1 wPtr tb5;
  306.     };
  307.  
  308. waitForMouseInControlPart :: !ControlHandle !Window !Int !DeltaControl !(UpdateFunction *s) !*s !Toolbox
  309.     -> (!Window, !*s, !Toolbox);
  310. waitForMouseInControlPart control window=:(wPtr, hBar, vBar, pict, updArea, zoom) part f update s tb
  311. |    not mouseDown            = (window, s, tb1);
  312. |    part1==part 
  313. &&    control1==control        = DoControl3 control window part hPos vPos f update s tb5;
  314.                                 with {
  315.                                     (hControl,_,_)    = hBar;
  316.                                     (vControl,_,_)    = vBar;
  317.                                     (hPos, tb4)        = GetCtlValue hControl tb3;
  318.                                     (vPos, tb5)        = GetCtlValue vControl tb4;
  319.                                 };
  320.                             = waitForMouseInControlPart control window part f update s tb3;
  321.     where {
  322.         (mouseDown,tb1)            = WaitMouseUp tb;
  323.         ((h1,v1),tb2)            = InGrafport wPtr GetMousePosition tb1;
  324.         (part1,control1,tb3)    = FindControl h1 v1 wPtr tb2;
  325.     };
  326.  
  327. GetMousePosition :: !Toolbox -> (!Point, !Toolbox);
  328. GetMousePosition tb
  329.     =    ((x,y),tb1);
  330.     where {
  331.         (x, y, tb1) = GetMouse tb;
  332.     };
  333.  
  334. Wait_mouse_up :: !Toolbox -> Toolbox;
  335. Wait_mouse_up tb
  336. |    mouseDown    = Wait_mouse_up tb1;
  337.                 = tb1;
  338.     where {
  339.         (mouseDown, tb1) = WaitMouseUp tb;
  340.     };
  341.  
  342. MoveThumb :: !ControlHandle !Window !Int !Int !(UpdateFunction *s) !*s !Toolbox
  343.     ->    (!Window, !*s, !Toolbox);
  344. MoveThumb control window=:(wPtr, hBar, vBar, pict, updArea, zoom) h v update s tb
  345. |    finalPart == InThumb    = Scroll_window window oldHpos oldVpos hPos vPos update s tb10;
  346.                             = (window, s, tb3);
  347.     where {
  348.         (hControl, hScroll, hMax)    = hBar;
  349.         (vControl, vScroll, vMax)    = vBar;
  350.         (oldHpos,    tb1)            = GetCtlValue hControl tb;
  351.         (oldVpos,    tb2)            = GetCtlValue vControl tb1;
  352.         (finalPart, tb3)            = TrackControl control h v 0 tb2;
  353.         (curHpos,    tb4)            = GetCtlValue hControl tb3;
  354.         (cHMin,        tb5)            = GetCtlMin    hControl tb4;
  355.         (cHMax,        tb6)            = GetCtlMax    hControl tb5;
  356.         (curVpos,    tb7)            = GetCtlValue    vControl tb6;
  357.         (cVMin,        tb8)            = GetCtlMin    vControl tb7;
  358.         (cVMax,        tb9)            = GetCtlMax    vControl tb8;
  359.         hPos                        = Align_thumb curHpos cHMin cHMax hScroll;
  360.         vPos                        = Align_thumb curVpos cVMin cVMax vScroll;
  361.         tb10                        = SetCtlValue vControl vPos (SetCtlValue hControl hPos tb9);
  362.     };
  363.  
  364. Align_thumb    :: !Int !Int !Int !Int -> Int;
  365. Align_thumb thumb min max scroll
  366. |    thumb == max    = thumb;
  367.                     = min + dThumb - (dThumb mod scroll);
  368.     where {
  369.         dThumb = thumb - min;
  370.     };
  371.